\ $VER: SwapColors.f 1.01 (19 Jan 1992 23:28)
\ Program to swap the colors 2 and 3 of a number icons simultaneously,
\   using the Workbench and Intuition.
\ Written in JForth Professional 2.0
\
\ (c) Copyright 1992 by Richard Mazzarisi
\	All rights reserved.
\
\ address:
\	891 Post St. #207
\	San Francisco, CA
\	94109
\
\  email:
\	rich@californium.cchem.berkeley.edu
\	rmazz@hydrogen.cchem.berkeley.edu
\	nmr@garnet.berkeley.edu
\
\
\ v. 1.00 1/11/92
\	  1/13/92  moved the resource management routines to IconTools.f
\ v. 1.01 1/19/92  recompiled with new IconTools.f (cf)
\
\ Instructions:
\ 1 - Click on the icon for this program.
\ 2 - Shift click on all icons to be changed.
\
\ (NOTE: The author assumes no responsibility for any damages
\ resulting from the use of this program.)


INCLUDE? TASK-ICONTOOLS ICONTOOLS.F


ANEW task-swapcolors

DECIMAL


\ *** main window stuff ***

: open.sc-window	( -- window/null )
	getWBscreendata
	it-newwindow NEWWINDOW.SETUP
	20 16 set.vert-params
	it-newwindow ..! nw_Height
	it-newwindow ..! nw_TopEdge
	20 52 set.horiz-params
	it-newwindow ..! nw_Width
	it-newwindow ..! nw_LeftEdge
	0" SwapColors  1.01" >ABS it-newwindow ..! nw_Title
	CLOSEWINDOW it-newwindow ..! nw_IDCMPFlags
	WINDOWCLOSE WINDOWDRAG | WINDOWDEPTH | WINDOWSIZING | ACTIVATE |
		it-newwindow ..! nw_Flags
	it-newwindow GR.OPENCURW
;


\ *** support ***

: sc.greeting		( -- )
	" Swap colors 1 and 2 in the Image of Icons." con.write.itl con.cr
	" © Copyright by Richard Mazzarisi 1992" con.write.c3 con.cr
	"          All rights reserved." con.write.c3 con.cr
	"      Written in JForth Professional 2.0." con.write.c3 con.cr con.cr
;


: prt.sc-instr		( -- )
	" Instructions:"  con.write con.cr
	" 1 - Click on the icon for this program."  con.write con.cr
	" 2 - Shift click on all icons to be changed."  con.write con.cr con.cr
	" (NOTE: The author assumes no responsibility for any"
	con.write con.cr
	" damages resulting from the use of this program.)" con.write con.cr
;


: swap.1-2       { gadimage | nwords plane0 plane1 -- }
        gadimage ..@ ig_Width  15 +  16 /            \ # 16 bit words across
        gadimage ..@ ig_Height  * -> nwords
        gadimage ..@ ig_ImageData  >REL DUP -> plane0
        nwords 2* ( offset in bytes ) + -> plane1
        nwords 0 DO
        	\ swapping the planes will swap colors 1 & 2
        	\ ie.  {0101,0011} -> {0011,0101} or 0->0 1->2 2->1 3->3
                plane0 W@  plane1 W@
                plane0 W!  plane1 W!
                no@  2 plane0 +!  2 plane1 +!  yes@
        LOOP
;


: swap.it	{ | icongad -- }
	PAD $it.get-icon
	theICON @ .. do_Gadget  DUP -> icongad
	..@ gg_GadgetRender >REL
	\ check for a 4 colors and whether it is an image (not border)
	DUP ..@ ig_Depth 2 =
	icongad ..@ gg_Flags  GADGIMAGE AND  0>  AND  IF
		swap.1-2
		\ check for highlight image
		icongad ..@ gg_Flags  GADGHIGHBITS AND  GADGHIMAGE = IF
			icongad ..@ gg_SelectRender >REL  swap.1-2
		THEN
[ clone-it @ ] .IF
		PAD $it.save-icon
.ELSE
\ don't really do it if we are testing things in the interpreter
		it.abort-icon
.THEN
        ELSE
        	"    Not a 4 color image!  Not changed." con.write con.cr
        	DROP
		it.abort-icon
        THEN
;


: swap.one	{ wb-arg -- }
	\ get file's path name
	wb-arg get.full-path IF
		"   " con.write
		PAD con.write con.cr
		swap.it
	ELSE
		" ERROR: Could not get path for icon:" con.write.itl con.cr
		"   " con.write
		wreq @ wb-arg ..@ wa_Name >REL ConPutStr() con.cr
	THEN
;


: do.swaps	{ #args -- }
	\ go thru icons to be changed
        " Click closebox to abort."  con.write con.cr con.cr
	" Swapping the colors for:" con.write con.cr
        \ get pointer to args
	WBMESSAGE @ >REL ..@ sm_ArgList >REL
	\ 2nd and on are the icons to work on
	#args 1+  1  DO
                DUP  SizeOf() WBArg  I *  +
                swap.one
		\ check for stop action
		?CLOSEBOX IF LEAVE THEN
	LOOP
	DROP
	con.cr " Done.  " con.write.itl
;


\ *** main ***

: swapcolors		( -- )
	' prt.sc-instr IS prt.it-instr
	' open.sc-window IS open.it-window
	open.it-things
	cursor.off
	sc.greeting
	check.WB
	2 check.num.args IF
		do.swaps
	THEN
	close.it-things
;


: sc
	swapcolors
;


clone-it @ .IF

initclone
clone swapcolors
save-image swapcolors SwapColors -icon

.THEN

CR CR ." Type 'sc to run." CR CR
